home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Viewers.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-11-18  |  7.2 KB  |  230 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. Syntax12.Scn.Fnt
  3. MODULE Viewers; (*JG 14.9.90*)
  4.     IMPORT Display, Macintosh;
  5.     CONST
  6.       restore* = 0; modify* = 1; suspend* = 2; (*message ids*)
  7.       inf = MAX(INTEGER);
  8.     TYPE
  9.        Viewer* = POINTER TO ViewerDesc;
  10.        ViewerDesc* = RECORD
  11.            (Display.FrameDesc)
  12.            state*: INTEGER
  13.        END;
  14.        (*state > 1: displayed
  15.             state = 1: filler
  16.             state = 0: closed
  17.             state < 0: suspended*)
  18.        ViewerMsg* = RECORD
  19.           (Display.FrameMsg)
  20.            id*: INTEGER;
  21.            X*, Y*, W*, H*: INTEGER;
  22.            state*: INTEGER
  23.        END;
  24.        Track = POINTER TO TrackDesc;
  25.        TrackDesc = RECORD
  26.            (ViewerDesc)
  27.            under: Display.Frame
  28.        END;
  29.     VAR
  30.       curW*, minH*, DW, DH: INTEGER;
  31.       FillerTrack: Track; FillerViewer, buf: Viewer; (*for closed viewers*)
  32.     PROCEDURE Open* (V: Viewer; X, Y: INTEGER);
  33.         VAR T, u, v: Display.Frame; M: ViewerMsg;
  34.     BEGIN
  35.         IF (V.state = 0) & (X < inf) THEN
  36.           IF Y > DH THEN Y := DH END;
  37.           T := FillerTrack.next;
  38.           WHILE X >= T.X + T.W DO T := T.next END;
  39.           u := T.dsc; v := u.next;
  40.           WHILE Y > v.Y + v.H DO u := v; v := u.next END;
  41.           IF Y < v.Y + minH THEN Y := v.Y + minH END;
  42.           IF (v.next.Y # 0) & (Y > v.Y + v.H - minH) THEN
  43.             WITH v: Viewer DO
  44.               V.X := T.X; V.W := T.W; V.Y := v.Y; V.H := v.H;
  45.               M.id := suspend; M.state := 0;
  46.               v.handle(v, M); v.state := 0; buf := v;
  47.               V.next := v.next; u.next := V;
  48.               V.state := 2
  49.             END
  50.           ELSE
  51.             V.X := T.X; V.W := T.W; V.Y := v.Y; V.H := Y - v.Y;
  52.             M.id := modify; M.Y := Y; M.H := v.Y + v.H - Y;
  53.             v.handle(v, M); v.Y := M.Y; v.H := M.H;
  54.             V.next := v; u.next := V;
  55.             V.state := 2
  56.           END
  57.         END
  58.     END Open;
  59.     PROCEDURE Change* (V: Viewer; Y: INTEGER);
  60.         VAR v: Display.Frame; M: ViewerMsg;
  61.     BEGIN
  62.         IF V.state > 1 THEN
  63.            IF Y > DH THEN Y := DH END;
  64.            v := V.next;
  65.            IF (v.next.Y # 0) & (Y > v.Y + v.H - minH) THEN
  66.               Y := v.Y + v.H - minH
  67.           END;
  68.           IF Y >= V.Y + minH THEN
  69.               M.id := modify; M.Y := Y; M.H := v.Y + v.H - Y;
  70.               v.handle(v, M); v.Y := M.Y; v.H := M.H;
  71.               V.H := Y - V.Y
  72.           END
  73.        END
  74.     END Change;
  75.     PROCEDURE RestoreTrack (S: Display.Frame);
  76.         VAR T, t, v: Display.Frame; M: ViewerMsg;
  77.     BEGIN
  78.         WITH S: Track DO
  79.            t := S.next;
  80.             WHILE t.next.X # S.X DO t := t.next END;
  81.             T := S.under;
  82.             WHILE T.next # NIL DO T := T.next END;
  83.             t.next := S.under; T.next := S.next;
  84.             M.id := restore;
  85.             REPEAT t := t.next;
  86.                 v := t.dsc;
  87.                 REPEAT v := v.next; v.handle(v, M);
  88.                     WITH v: Viewer DO v.state := - v.state END
  89.                 UNTIL v = t.dsc
  90.             UNTIL t = T
  91.          END
  92.      END RestoreTrack;
  93.     PROCEDURE Close* (V: Viewer);
  94.         VAR T, U: Display.Frame; M: ViewerMsg;
  95.     BEGIN
  96.         IF V.state > 1 THEN
  97.             U := V.next; T := FillerTrack;
  98.             REPEAT T := T.next UNTIL V.X < T.X + T.W;
  99.             IF (T(Track).under = NIL) OR (U.next # V) THEN
  100.                 M.id := suspend; M.state := 0;
  101.                 V.handle(V, M); V.state := 0; buf := V;
  102.                 M.id := modify; M.Y := V.Y; M.H := V.H + U.H;
  103.                 U.handle(U, M); U.Y := M.Y; U.H := M.H;
  104.                 WHILE U.next # V DO U := U.next END;
  105.                 U.next := V.next
  106.             ELSE (*close track*)
  107.                 M.id := suspend; M.state := 0;
  108.                 V.handle(V, M); V.state := 0; buf := V;
  109.                 U.handle(U, M); U(Viewer).state := 0;
  110.                 RestoreTrack(T)
  111.             END
  112.         END
  113.      END Close;
  114.     PROCEDURE Recall* ( VAR V: Viewer);
  115.     BEGIN V := buf
  116.     END Recall;
  117.     PROCEDURE This* (X, Y: INTEGER): Viewer;
  118.         VAR T, V: Display.Frame;
  119.     BEGIN
  120.         IF (X < inf) & (Y < DH) THEN
  121.             T := FillerTrack;
  122.             REPEAT T := T.next UNTIL X < T.X + T.W;
  123.             V := T.dsc;
  124.             REPEAT V := V.next UNTIL Y < V.Y + V.H;
  125.             RETURN V(Viewer)
  126.         ELSE RETURN NIL
  127.         END
  128.     END This;
  129.     PROCEDURE Next* (V: Viewer): Viewer;
  130.     BEGIN RETURN V.next(Viewer)
  131.     END Next;
  132.     PROCEDURE Locate* (X, H: INTEGER; VAR fil, bot, alt, max: Display.Frame);
  133.         VAR T, V: Display.Frame;
  134.     BEGIN
  135.         IF X < inf THEN
  136.             T := FillerTrack;
  137.             REPEAT T := T.next UNTIL X < T.X + T.W;
  138.             fil := T.dsc; bot := fil.next;
  139.             IF bot.next # fil THEN
  140.                 alt := bot.next; V := alt.next;
  141.                 WHILE (V # fil) & (alt.H < H) DO
  142.                     IF V.H > alt.H THEN alt := V END; V := V.next
  143.                 END
  144.             ELSE alt := bot
  145.             END;
  146.             max := T.dsc; V := max.next;
  147.             WHILE V # fil DO
  148.                 IF V.H > max.H THEN max := V END; V := V.next
  149.             END
  150.         END
  151.     END Locate;
  152.     PROCEDURE InitTrack* (W, H: INTEGER; Filler: Viewer);
  153.         VAR S: Display.Frame; T: Track;
  154.     BEGIN
  155.         IF Filler.state = 0 THEN
  156.             Filler.X := curW; Filler.W := W; Filler.Y := 0; Filler.H := H;
  157.             Filler.state := 1;
  158.             Filler.next := Filler;
  159.             NEW(T);
  160.             T.X := curW; T.W := W; T.H := H;
  161.             T.dsc := Filler; T.under := NIL;
  162.             FillerViewer.X := curW + W; FillerViewer.W := inf - FillerViewer.X;
  163.             FillerTrack.X := FillerViewer.X; FillerTrack.W := FillerViewer.W;
  164.             S := FillerTrack;
  165.             WHILE S.next # FillerTrack DO S := S.next END;
  166.             S.next := T; T.next := FillerTrack;
  167.             curW := curW + W
  168.         END
  169.     END InitTrack;
  170.     PROCEDURE OpenTrack* (X, W: INTEGER; Filler: Viewer);
  171.         VAR newT: Track; S, T, t, v: Display.Frame; M: ViewerMsg;
  172.     BEGIN
  173.         IF (X < inf) & (Filler.state = 0) THEN
  174.             S := FillerTrack; T := S.next;
  175.             WHILE X >= T.X + T.W DO S := T; T := S.next END;
  176.             WHILE X + W > T.X + T.W DO T := T.next END;
  177.             M.id := suspend;
  178.             t := S;
  179.             REPEAT t := t.next; v := t.dsc;
  180.                 REPEAT v := v.next;
  181.                     WITH v: Viewer DO
  182.                       M.state := -v.state; v.handle(v, M); v.state := M.state
  183.                     END
  184.                 UNTIL v = t.dsc
  185.             UNTIL t = T;
  186.             Filler.X := S.next.X; Filler.W := T.X + T.W - S.next.X; Filler.Y := 0; Filler.H := DH;
  187.             Filler.state := 1;
  188.             Filler.next := Filler;
  189.             NEW(newT);
  190.              newT.X := Filler.X; newT.W := Filler.W; newT.H := DH;
  191.             newT.dsc := Filler; newT.under := S.next; S.next := newT;
  192.             newT.next := T.next; T.next := NIL
  193.         END
  194.     END OpenTrack;
  195.     PROCEDURE CloseTrack* (X: INTEGER);
  196.         VAR T, V: Display.Frame; M: ViewerMsg;
  197.     BEGIN
  198.         IF X < inf THEN
  199.             T := FillerTrack;
  200.             REPEAT T := T.next UNTIL X < T.X + T.W;
  201.             IF T(Track).under # NIL THEN
  202.                 M.id := suspend; M.state := 0; V := T.dsc;
  203.                 REPEAT V := V.next; V.handle(V, M); V(Viewer).state := 0 UNTIL V = T.dsc;
  204.                 RestoreTrack(T)
  205.             END
  206.         END
  207.     END CloseTrack;
  208.     PROCEDURE Broadcast* (VAR M: Display.FrameMsg);
  209.         VAR T, V: Display.Frame;
  210.     BEGIN
  211.         T := FillerTrack.next;
  212.         WHILE T # FillerTrack DO
  213.             V := T.dsc; 
  214.             REPEAT V := V.next; V.handle(V, M) UNTIL V = T.dsc;
  215.             T := T.next
  216.         END;
  217.         Macintosh.FlushCache
  218.     END Broadcast;
  219. BEGIN
  220.     NEW(FillerViewer);
  221.     FillerViewer.W := inf; FillerViewer.H := DH;
  222.     FillerViewer.next := FillerViewer;
  223.     NEW(FillerTrack);
  224.     FillerTrack.W := inf; FillerTrack.H := DH;
  225.     FillerTrack.dsc := FillerViewer;
  226.     FillerTrack.next := FillerTrack;
  227.     minH := 1;
  228.     DW := Display.Width; DH := Display.Height
  229. END Viewers.
  230.